COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Editor: Aux routines for parsing motion-type statements }
C00005 00003	(* eMoveParse *)
C00010 00004	(* eStopParse *)
C00013 00005	(* eReturnParse *)
C00015 00006	(* eWristParse *)
C00017 ENDMK
C⊗;
{$NOMAIN	Editor: Aux routines for parsing motion-type statements }

%include eparse.hdr;

{ Externally defined routines from elsewhere: }

	(* From ALLOC *)
function newNode: nodep;					external;
procedure relNode(n: nodep);					external;

	(* From EROOT:  Inter-overlay calls *)
function e3fExprParse: nodep;					external;

	(* From PAUX1 *)
function getDtype(n: nodep): datatypes;				external;
function checkArg(n: nodep; d: datatypes): nodep;		external;

	(* From PAUX2 *)
function getdim(n: nodep; var d: nodep): nodep;			external;
function evalOrder(what,last: nodep; pcons: boolean): nodep;	external;
procedure relExpr(n: nodep);					external;

	(* From ETOKEN *)
procedure eGetToken;						external;
procedure eDimCheck(n,d: nodep);				external;
procedure eGetDelim(char: ascii);				external;

	(* From EMOVEO *)
procedure moveOrder(st: statementp);				external;

	(* From PP *)
procedure ppLine; 						external;
procedure ppOutNow; 						external;
procedure ppChar(ch: ascii); 					external;
procedure pp5(ch: c5str; length: integer); 			external;
procedure pp10(ch: cstring; length: integer); 			external;
procedure pp10L(ch: cstring; length: integer);			external;
procedure pp20(ch: c20str; length: integer); 			external;
procedure pp20L(ch: c20str; length: integer); 			external;
procedure ppInt(i: integer); 					external;
procedure ppReal(r: real); 					external;
procedure ppStrng(length: integer; s: strngp); 			external;
procedure ppDtype(d: datatypes);				external;
procedure ppDelChar; 						external;


procedure ePar3fGet; external;
procedure ePar3fGet;  begin end;

(* eMoveParse *)

procedure eMoveParse(st: statementp; bp: boolean); external;
procedure eMoveParse;
 var b,movep,operatep,centerp,openp: boolean; dest: nodep;
 begin
 with st↑ do
  begin
  movep := false;
  operatep := false;
  centerp := false;
  openp := false;
  if stype = movetype then movep := true
   else if stype = operatetype then operatep := true
   else if stype = centertype then centerp := true
   else openp := true;
  if movep or centerp then 			(* what are we moving *)
    cf := checkArg(e3fExprParse,frametype)
   else cf := checkArg(e3fExprParse,svaltype);
  with cf↑ do					(* make sure it's a variable *)
   begin
   b := (ntype <> leafnode) or (ltype <> varitype);
   if b then b := (ntype <> exprnode) or (op <> arefop);
   if not b then			(* ok so far, check some more *)
    if centerp then
     begin					(* check for arms *)
     if ntype <> leafnode then b := true
      else b := (vari↑.level <> 0) or not (vari↑.offset in [0,4,8,12]);
	(* offsets: 0=barm, 4=yarm, 8=garm, 12=rarm *)
     end
    else if operatep then
     begin					(* check for driver *)
     if ntype <> leafnode then b := true
      else b := (vari↑.level <> 0) or (vari↑.offset <> 16);
	(* offset: 16=driver *)
     end
    else if openp then
     begin					(* check for scalar devices *)
     if ntype <> leafnode then b := true
      else b := (vari↑.level <> 0) or not (vari↑.offset in [2,6,10,14,20]);
	(* offsets: 2=bhand, 6=yhand, 10=ghand, 14=rhand, 20=vise *)
     end;
   end;
  if b then
    begin
    pp20L(' Need a device varia',20); pp10('ble here  ',8); ppLine;
(* *** mark motion statement bad ??? *** *)
    end;
  if clauses = nil then dest := nil
   else if clauses↑.ntype <> destnode then dest := nil
   else begin dest := clauses; relExpr(dest↑.loc) end;
  eGetToken;				(* see if there's a TO clause *)
  with eCurToken do
   begin
   if (ttype = reswdtype) and (rtype = filtype) and (filler = totype) then
     begin					(* get destination *)
     if dest = nil then
       begin				(* make a new destination node *)
       dest := newNode;
       with dest↑ do
	begin
	ntype := destnode;
	code := nil;
	next := clauses;			(* splice us into clause list *)
	clauses := dest;
	end;
       end;
     with dest↑ do
      begin
      if movep then loc := checkArg(e3fExprParse,transtype)
       else loc := checkArg(e3fExprParse,svaltype);
      eDimCheck(loc,distancedim↑.dim);
      eGetToken;			(* see if anything else on line *)
      end
     end
    else
     if dest <> nil then		(* delete old destination clause *)
       begin 
       clauses := dest↑.next;
       relNode(dest);
       end;
   eBackup := true;
   if not (bp or endOfLine or ((ttype = delimtype) and (ch = ';'))) then
     begin
     pp20L('Sorry, can''t deal wi',20); pp20('th last part of line',20); ppLine;
     (* *** maybe instead should call addstmnt here??? *** *)
     end;
   end;
  end;

 moveOrder(st);
 end;

(* eStopParse *)

procedure eStopParse(st: statementp); external;
procedure eStopParse;
 var d: datatypes; b: boolean; i: integer;
 begin					(* stop statement *)
 with st↑ do
  begin
  b := true;
  clauses := nil;
  cf := e3fExprParse;			(* what are we stopping? *)
  if cf = nil then	(* use default = cf of current motion (if any) *)
    begin
    i := cursor;
    while (i > 1) and b do
     with cursorStack[i] do
      if stmntp and (movetype <= st↑.stype) and (st↑.stype <= centertype) then
	b := false else i := i - 1;
    if b then
      begin
      pp20L(' Need to specify wha',20); pp10('t to Stop ',9); ppLine;
      end
    end
   else
    begin				(* make sure it's a variable *)
    d := getDtype(cf);
    with cf↑ do
     if ((ntype = leafnode) and (ltype = varitype)) or
	((ntype = exprnode) and (op = arefop)) then	(* a variable? *)
       if d = frametype then b := false		(* assume any frame var is ok *)
	else if (d = svaltype) and (ntype = leafnode) then
	 if (vari↑.level = 0) and	(* check for scalar devices *)
	    (vari↑.offset in [2,6,10,14,16,20]) then b := false;
	(* offsets: 2=bhand, 6=yhand, 10=ghand, 14=rhand, 16=driver, 20=vise *)
    if b then
      begin					(* no good *)
      pp20L(' Need a device varia',20); pp10('ble here  ',8); ppLine;
      end
    end
  end;
 end;

(* eReturnParse *)

procedure eReturnParse(st: statementp); external;
procedure eReturnParse;
 var n,np: nodep;
 begin
 relExpr(st↑.retval);			(* flush the old expression *)
 st↑.retval := e3fExprParse;		(* parse the modified expression *)
 n := st↑.rproc;			(* find def of procedure we're in *)
 if n = nil then
   begin		(* yow - shouldn't allow a return here *)
   pp20L(' Can''t have a return',20); pp5('here ',4); ppLine;
   end
  else if n↑.pname↑.vtype = nulltype then
   begin			(* procedure doesn't return a result *)
   pp20L(' Procedure doesn''t r',20); pp20('eturn result        ',12); ppLine;
   end
  else if st↑.retval <> nil then
   begin
   st↑.retval := checkArg(st↑.retval,n↑.pname↑.vtype);
   np := nil;
   eDimCheck(st↑.retval,getdim(n,np));
   relNode(np);
   end
  else
   begin pp20L(' Need a value to ret',20); pp10('urn with  ',8); ppLine end;
 with st↑ do
  if retval <> nil then exprs := evalOrder(retval,nil,true);
 end;

(* eWristParse *)

procedure eWristParse(st: statementp); external;
procedure eWristParse;
 var b: boolean; n: nodep;
 begin
 with st↑ do
  begin
  n := nil;
  b := false;
  fvec := checkArg(e3fExprParse,vectype);
  eDimCheck(fvec,forcedim↑.dim);
  with fvec↑ do			(* make sure it's a variable *)
   if (ntype = exprnode) and (op = arefop) then
     n := evalorder(arg2,n,true)	(* deal with subscripts *)
    else b := not ((ntype = leafnode) and (ltype = varitype));
  eGetDelim(',');
  tvec := checkArg(e3fExprParse,vectype);
  eDimCheck(tvec,torquedim↑.dim);
  with tvec↑ do			(* make sure it's a variable *)
   if (ntype = exprnode) and (op = arefop) then
     n := evalorder(arg2,n,true)	(* deal with subscripts *)
    else if not ((ntype = leafnode) and (ltype = varitype)) then
     b := true;			(* no good *)
  exprs := n;
  if b then
    begin
  (* *** mark us as bad *** *)
    pp20L(' Need variable here ',19); ppLine;
    end;
  end
 end;